home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / REALCTRL.I < prev    next >
Encoding:
Modula Implementation  |  1990-10-11  |  5.6 KB  |  229 lines
  1. IMPLEMENTATION MODULE RealCtrl;
  2. (*$N+,Y+,L-*)
  3.  
  4. (* für später...
  5. PROCEDURE Long (sr: REAL; format: RealFormat): AnyReal;
  6. PROCEDURE Short (longReal: AnyReal): REAL;
  7.   (*
  8.    * Konvertieren von REAL nach LONGREAL bzw. umgekehrt im angegebenen
  9.    * Format (das Format wird beibehalten).
  10.    *)
  11. *)
  12.  
  13. FROM SYSTEM IMPORT ASSEMBLER;
  14. IMPORT MOSCtrl;
  15.  
  16. PROCEDURE SmallREAL     (format: RealFormat): LONGREAL;
  17.   BEGIN
  18.     ASSEMBLER
  19.         TST     -(A3)
  20.         BNE     ieee
  21.         MOVE.L  #$FE028000,(A3)+
  22.         MOVE.L  #$00000000,(A3)+
  23.         RTS
  24.       ieee
  25.         MOVE.L  #$36A00000,(A3)+
  26.         MOVE.L  #$00000000,(A3)+
  27.     END
  28.   END SmallREAL;
  29.  
  30. PROCEDURE LargeREAL     (format: RealFormat): LONGREAL;
  31.   BEGIN
  32.     ASSEMBLER
  33.         TST     -(A3)
  34.         BNE     ieee
  35.         MOVE.L  #$01FAFFFF,(A3)+
  36.         MOVE.L  #$FF000000,(A3)+
  37.         RTS
  38.       ieee
  39.         MOVE.L  #$47EFFFFF,(A3)+
  40.         MOVE.L  #$E0000000,(A3)+
  41.     END
  42.   END LargeREAL;
  43.  
  44. PROCEDURE SmallLONGREAL (format: RealFormat): LONGREAL;
  45.   BEGIN
  46.     ASSEMBLER
  47.         TST     -(A3)
  48.         BNE     ieee
  49.         MOVE.L  #$80628000,(A3)+
  50.         MOVE.L  #$00000000,(A3)+
  51.         RTS
  52.       ieee
  53.         MOVE.L  #$00000000,(A3)+
  54.         MOVE.L  #$00000001,(A3)+
  55.     END
  56.   END SmallLONGREAL;
  57.  
  58. PROCEDURE LargeLONGREAL (format: RealFormat): LONGREAL;
  59.   BEGIN
  60.     ASSEMBLER
  61.         TST     -(A3)
  62.         BNE     ieee
  63.         MOVE.L  #$7FC2FFFF,(A3)+
  64.         MOVE.L  #$FFFFFFFF,(A3)+
  65.         RTS
  66.       ieee
  67.         MOVE.L  #$7FEFFFFF,(A3)+
  68.         MOVE.L  #$FFFFFFFF,(A3)+
  69.     END
  70.   END LargeLONGREAL;
  71.  
  72. PROCEDURE Conv (in: AnyReal; out: RealFormat): LONGREAL;
  73.   BEGIN
  74.     ASSEMBLER
  75.         MOVE.W  -(A3),D0        ; out-Format
  76.         CMP.W   -(A3),D0        ; in-Format
  77.         BEQ     ende            ; beide Formate sind schon gleich
  78.         
  79.         LEA     -8(A3),A0
  80.         TST     D0
  81.         BNE     toIEEE
  82.         
  83.         ; *** IEEE (A0) to MM2 (A0) ***
  84.         ; Mantisse laden
  85.         MOVE.L  (A0),D1
  86.         MOVE.L  4(A0),D2
  87.         ; Mantisse und Exp um 4 Bit runterschieben
  88.         LSR.L   #1,D1
  89.         ROXR.L  #1,D2
  90.         LSR.L   #1,D1
  91.         ROXR.L  #1,D2
  92.         LSR.L   #1,D1
  93.         ROXR.L  #1,D2
  94.         LSR.L   #1,D1
  95.         ROXR.L  #1,D2
  96.         ; D1.W:D2.L enthalten die Mantisse
  97.         
  98.         MOVE.L  D1,D0
  99.         SWAP    D0
  100.         ANDI    #$07FF,D0
  101.         ; D0 enthält Exponenten + Bias 1023
  102.         BEQ     denorm
  103.         
  104.         SUBI    #1023,D0        ; Bias vom Exp abziehen
  105.         ; Bit 47 v. MM2-Real setzen und dafür Exp um Eins erhöhen
  106.         LSR.W   #1,D1
  107.         ROXR.L  #1,D2
  108.         BSET    #15,D1
  109.         ADDQ    #1,D0
  110.       final
  111.         LSL.W   #3,D0
  112.         TST.W   (A0)            ; negativ?
  113.         BPL     pos
  114.         BSET    #0,D0
  115.       pos
  116.         BSET    #1,D0           ;non-zero Bit setzen
  117.         SWAP    D0
  118.         MOVE    D1,D0
  119.         MOVE.L  D0,(A0)
  120.         MOVE.L  D2,4(A0)
  121.       ende
  122.         RTS
  123.         
  124.       denorm
  125.         ; prüfen, ob Wert Null ist
  126.         TST.W   D1
  127.         BNE     notNull2
  128.         TST.L   D2
  129.         BNE     notNull
  130.         
  131.         ; Zahl ist Null
  132.         CLR.L   (A0)
  133.         CLR.L   4(A0)
  134.         RTS
  135.         
  136.       notNull2
  137.         BPL     notNull
  138.         ; wenn D1 negativ, dann ist Zahl für MM2-Format bereits normalisiert
  139.         SUBI    #1023,D0        ; Bias vom Exp abziehen
  140.         BRA     final
  141.         
  142.       notNull
  143.         ; Zahl ist denormalisiert
  144.       norm
  145.         SUBQ    #1,D0
  146.         LSL.L   #1,D2
  147.         ROXL.W  #1,D1
  148.         BCC     norm
  149.         SUBI    #1023,D0        ; Bias vom Exp abziehen
  150.         BRA     final
  151.         
  152.       toIEEE
  153.         ; *** MM2 (A0) to IEEE (A0) ***
  154.         ; liefert Infinity, wenn MM2-Wert zu groß ist
  155.         MOVE.W  (A0),D0         ; Exp laden
  156.         BEQ     isNull
  157.         ASR     #3,D0
  158.         MOVEQ   #0,D1
  159.         MOVE.W  2(A0),D1
  160.         MOVE.L  4(A0),D2
  161.         
  162.         ; Bias addieren
  163.         ; (incl. dem angepaßten Exp-Offset für's entfernte 0.5-Bit)
  164.         ADDI    #1023-1,D0
  165.         
  166.         CMPI    #2048,D0
  167.         BGE     overflow        ; wenn Exp größer als 1024 war, dann Overflow
  168.         BCS     norm2           ; wenn Exp zw. -1023 und 1024 lag, dann ok
  169.         CMPI    #-51,D0         ; können wir Zahl denormalisieren?
  170.         BLT     isNull          ; wenn Exp zu klein, dann Null liefern
  171.         
  172.         ; denormalisieren
  173.       denorm2
  174.         ADDQ    #1,D0
  175.         BEQ     final2
  176.         LSR.W   #1,D1
  177.         ROXR.L  #1,D2
  178.         BRA     denorm2
  179.         
  180.       norm2
  181.         ; 0.5-Wert Bit rausschieben (Exp bereits angepaßt)
  182.         LSL.L   #1,D2
  183.         ROXL.W  #1,D1
  184.         
  185.       final2
  186.         SWAP    D0
  187.         MOVE.W  D1,D0
  188.         ; Mantisse und Exp um 4 Bit aufschieben
  189.         LSL.L   #1,D2
  190.         ROXL.L  #1,D0
  191.         LSL.L   #1,D2
  192.         ROXL.L  #1,D0
  193.         LSL.L   #1,D2
  194.         ROXL.L  #1,D0
  195.         LSL.L   #1,D2
  196.         ROXL.L  #1,D0
  197.         ; Sign setzen
  198.         BTST    #0,1(A0)
  199.         BEQ     pos2
  200.         BSET    #31,D0
  201.       pos2
  202.         MOVE.L  D0,(A0)
  203.         MOVE.L  D2,4(A0)
  204.         RTS
  205.         
  206.       overflow
  207.         ; Infinity liefern
  208.         MOVEQ   #0,D1
  209.         MOVEQ   #0,D2
  210.         MOVE    #2047,D0
  211.         BRA     final2
  212.         
  213.       isNull
  214.         CLR.L   (A0)
  215.         CLR.L   4(A0)
  216.     END
  217.   END Conv;
  218.  
  219. BEGIN
  220.   ASSEMBLER
  221.         MOVEQ   #2,D1
  222.         MOVE.W  MOSCtrl.RealMode,D0
  223.         BEQ     ok
  224.         LSR     #1,D0
  225.         MOVE    D0,D1
  226.     ok: MOVE.W  D1,UsedFormat
  227.   END;
  228. END RealCtrl.
  229.